unit main;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons,
  ExtCtrls, ComCtrls, LazHelpCHM;

type

  { Tform_main }

  Tform_main = class(TForm)
    BitBtn1: TBitBtn;
    btn_Process: TBitBtn;
    btn_Open: TBitBtn;
    btn_Save: TBitBtn;
    CHMHelpDatabase1: TCHMHelpDatabase;
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    lbl_KeyWords: TLabel;
    lbl_KJVWords1: TLabel;
    LHelpConnector1: TLHelpConnector;
    memo_bible: TMemo;
    memo_Save_wordlist: TMemo;
    OpenBible: TOpenDialog;
    pnl_alpha_jump: TPanel;
    prgs_bar_are_we_there_yet: TProgressBar;
    saveWordList: TSaveDialog;
    StaticText1: TStaticText;
    procedure btn_OpenClick(Sender: TObject);
    procedure btn_ProcessClick(Sender: TObject);
    procedure btn_SaveClick(Sender: TObject);
    procedure cleanseNonAlpha(var thisText: string);
    procedure memo_Save_wordlistChange(Sender: TObject);
    procedure cleanseAlphabetlinks;
  private

  public

  end;

Const
   asciiLOWERstart = 97;   // a -
   asciiLOWEREnd  = 122;   // - z
   asciiUPPERstart = 65;   // A -
   asciiUPPERend   = 90;   // - Z
var
  form_main: Tform_main;

implementation

{$R *.lfm}

{ Tform_main }

// http://kingjamesbibledictionary.com/biblefacts
//  Unique Hebrew words: 8,674
//  Unique Greek words: 5,624
//  Unique English words: 12,143


procedure Tform_main.btn_OpenClick(Sender: TObject);
begin
  if OpenBible.Execute then
  begin

    application.ProcessMessages;
    cursor := crHourGlass;

    memo_bible.Lines.LoadFromFile(OpenBible.FileName);

    application.ProcessMessages;
    cursor:=crDefault;
    application.ProcessMessages;

  end;
end;

procedure Tform_main.btn_ProcessClick(Sender: TObject);
var
  thisLine,   wordList, upperWordList : tstringlist;
  thisWord, rawWord : string;
  count, rawWords : integer;
begin

  prgs_bar_are_we_there_yet.Position:=0;
  prgs_bar_are_we_there_yet.Min:= 0;
  prgs_bar_are_we_there_yet.Max:= memo_bible.Lines.Count;


  thisLine := tstringlist.Create;
  thisLine.Delimiter := #32;

  wordList := tstringlist.Create;
   wordList.SortStyle:=sslAuto;
   wordList.Sorted:=true;

  upperWordList := tstringlist.Create;
    upperWordList.SortStyle:=sslAuto;
   upperWordList.Sorted:=true;

   rawWords := 0;



  try
       for count := 0 to memo_bible.Lines.Count -1 do
          begin
          thisLine.DelimitedText := memo_bible.Lines[count];

             for rawWord in thisLine do
               begin
                   thisWord := trim(rawWord);

{speed ?}                 if thisWord = '' then continue;

                 cleanseNonAlpha(thisWord);

                          if thisWord = '' then continue;

                      inc(rawWords);

               If ord(thisWord[1]) >= asciiLOWERstart then
                   begin
                      if wordList.IndexOf(thisWord) = -1 then
                            wordList.Add(thisWord);
                   end
                    else
                      if upperWordList.IndexOf(thisWord) = -1 then
                            upperWordList.Add(thisWord);
                end;

             if (count mod 100 = 0) then
             begin
               application.ProcessMessages;
                  prgs_bar_are_we_there_yet.Position:= count;
               application.ProcessMessages;
              end;
          end;
       // updating a TMemeo directly in above would slow things down
       memo_Save_wordlist.Text := upperWordList.text
                               //  + #13#10
                                 + wordList.Text;

       lbl_KJVWords1.Caption := inttostr(rawWords);

                                           finally
    thisLine.Free;
    wordList.Free;
    upperWordList.Free;

  end;

end;

procedure Tform_main.btn_SaveClick(Sender: TObject);
begin
     if saveWordList.Execute then
     memo_Save_wordlist.Lines.SaveToFile(saveWordList.FileName);
end;

procedure Tform_main.cleanseNonAlpha(var thisText: string);
var
  count, thisValue : integer;
  rebuild : string = '';
begin
      for count := 1 to length(thisText) do
          begin
            thisValue := ord(thisText[count]);
             // Pure English alaphbet only
             // lowercase first (ascii UPPER number range) -- more frequent
           if ( (thisValue >= asciiUPPERstart) AND (thisValue <= asciiUPPERend) )
            OR
             ( (thisValue >= asciiLOWERstart) AND ( thisValue <= asciiLOWEREnd   ) )

             then
               rebuild := rebuild + thisText[count]
          end;

      thisText := rebuild;
end;

procedure Tform_main.memo_Save_wordlistChange(Sender: TObject);
begin
  lbl_KeyWords.Caption := inttostr(memo_Save_wordlist.lines.Count);
end;

procedure Tform_main.cleanseAlphabetlinks;
begin

end;

end.

